home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / dupsplf.arc / DUPSPLF.EXE / arc / DUPSPLFC.PGM < prev   
Text File  |  1988-01-25  |  5KB  |  98 lines
  1. /********************************************************************/
  2. /*   Duplicate Spool File Member                                    */
  3. /*                                                                  */
  4. /*   Mark S. Shashek    07-17-86                                    */
  5. /********************************************************************/
  6. PGM          PARM(&FILE &FULLJOB &PRTFILE &OUTQ &SPLNBR)
  7.  
  8.              DCL        VAR(&FULLJOB)   TYPE(*CHAR) LEN(26)
  9.              DCL        VAR(&JOB)       TYPE(*CHAR) LEN(10)
  10.              DCL        VAR(&USER)      TYPE(*CHAR) LEN(10)
  11.              DCL        VAR(&JOBNBR)    TYPE(*CHAR) LEN(6)
  12.              DCL        VAR(&FILE)      TYPE(*CHAR) LEN(10)
  13.              DCL        VAR(&PRTFILE)   TYPE(*CHAR) LEN(20)
  14.              DCL        VAR(&PRTFILEN)  TYPE(*CHAR) LEN(10)
  15.              DCL        VAR(&PRTFILEL)  TYPE(*CHAR) LEN(10)
  16.              DCL        VAR(&OUTQ)      TYPE(*CHAR) LEN(20)
  17.              DCL        VAR(&OUTQN)     TYPE(*CHAR) LEN(10)
  18.              DCL        VAR(&OUTQL)     TYPE(*CHAR) LEN(10)
  19.              DCL        VAR(&SPLNBR)    TYPE(*CHAR) LEN(6)
  20.              DCL        VAR(&MSGID)     TYPE(*CHAR) LEN(7)
  21.              DCL        VAR(&MSGDTA)    TYPE(*CHAR) LEN(80)
  22.  
  23.              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
  24.                        /* Any Error */
  25.  
  26.              CHGVAR     VAR(&PRTFILEN)  VALUE(%SST(&PRTFILE 1 10))
  27.                        /* Extract File */
  28.              CHGVAR     VAR(&PRTFILEL)  VALUE(%SST(&PRTFILE 11 10))
  29.                        /* Extract Library */
  30.              CHGVAR     VAR(&OUTQN)     VALUE(%SST(&OUTQ 1 10))
  31.                        /* Extract Outq */
  32.              CHGVAR     VAR(&OUTQL)     VALUE(%SST(&OUTQ 11 10))
  33.                        /* Extract Library */
  34.              CHGVAR     VAR(&JOB)       VALUE(%SST(&FULLJOB 1 10))
  35.                        /* Extract Job */
  36.              CHGVAR     VAR(&USER)      VALUE(%SST(&FULLJOB 11 10))
  37.                        /* Extract User */
  38.              CHGVAR     VAR(&JOBNBR)    VALUE(%SST(&FULLJOB 21 6))
  39.                        /* Extract Job Number */
  40.              CHKOBJ     OBJ(DUPSPLP.QTEMP) OBJTYPE(*FILE)
  41.                        /* Check for Temp PF */
  42.              MONMSG     MSGID(CPF9801) EXEC(DO) /* Does not Exist */
  43.                         CRTPF      FILE(DUPSPLP.QTEMP) RCDLEN(199)
  44.                                  /* Create File */
  45.              ENDDO
  46.  
  47.              IF         COND(&FULLJOB *EQ '*') THEN(DO) /* Same Job */
  48.                              CPYSPLF    FILE(&FILE)  +
  49.                                         TOFILE(DUPSPLP.QTEMP) +
  50.                                         SPLNBR(&SPLNBR) +
  51.                                         CTLCHAR(*FCFC)
  52.                                      /* Copy to Temp PF */
  53.                         ENDDO
  54.              ELSE       CMD(DO) /* Specific Job Name to be Used */
  55.              IF         COND(&USER *EQ '  ') THEN(DO)
  56.                              CHGVAR VAR(&USER) VALUE('*N')
  57.              ENDDO
  58.              IF         COND(&JOBNBR *EQ '  ') THEN(DO)
  59.                              CHGVAR VAR(&JOBNBR) VALUE('*N')
  60.              ENDDO
  61.                              CPYSPLF    FILE(&FILE)  +
  62.                                         TOFILE(DUPSPLP.QTEMP) +
  63.                                         JOB(&JOB.&USER.&JOBNBR) +
  64.                                         SPLNBR(&SPLNBR) +
  65.                                         CTLCHAR(*FCFC)
  66.                                      /* Copy to Temp PF */
  67.              ENDDO
  68.              IF         COND(&OUTQN *EQ '*PRTFILE') THEN(DO)
  69.                        /* Use Same Outq */
  70.                              OVRPRTF    FILE(QSYSPRT) +
  71.                                         TOFILE(&PRTFILEN.&PRTFILEL) +
  72.                                         CTLCHAR(*FCFC)
  73.                                      /* Override with FCFC */
  74.              ENDDO
  75.              ELSE       /* Use Named Outq and FCFC */
  76.                              OVRPRTF    FILE(QSYSPRT)  +
  77.                                         TOFILE(&PRTFILEN.&PRTFILEL) +
  78.                                         CTLCHAR(*FCFC) +
  79.                                         OUTQ(&OUTQN.&OUTQL)
  80.                              CPYF       FROMFILE(DUPSPLP.QTEMP) +
  81.                                         TOFILE(QSYSPRT)
  82.                                     /*  Duplicate File */
  83.                              SNDPGMMSG  MSG('Spool File ' +
  84.                                         *CAT &JOB +
  85.                                         *TCAT ' duplicated') +
  86.                                         MSGTYPE(*COMP)
  87.              RETURN     /* Good Completion */
  88.  
  89. ERROR:      /*  Any *EXCP msg is returned as an escape */
  90.              RCVMSG     MSGTYPE(*EXCP)  +
  91.                         MSGDTA(&MSGDTA) +
  92.                         MSGID(&MSGID)
  93.              SNDPGMMSG  MSGID(&MSGID)   +
  94.                         MSGF(QCPFMSG)   +
  95.                         MSGDTA(&MSGDTA) +
  96.                         MSGTYPE(*ESCAPE)
  97. ENDPGM
  98.